package CleverBot;
use strict;
#use warnings;
use Data::Dumper;
use POSIX qw/strftime/;

#> Это центральный модуль программы. Любые вызовы так или иначе проходят через него.
#> Основые его обязанности: 
#> 1. Запуск и контроль сканирования
#> 2. Создание промежуточного уровня абстракции от БД.
#> 3. Предоставление удобных подручных инструментов сканирующим модулям, и использующим его программам.
#> Пример его использования см. программу clever_bot.
#> Его функции также используются в CleverBot.Web.pm

sub new{
 #> Конструктор
 my $pkg = shift;
 my $self = { 
    db => undef, 
    dbh => undef,
    debug_call => 0,
    debug_explain => 0,
    start_time => &strftime("%F %T",localtime),
 };
 #> Возвращает ссылку на объект класса CleverBot
 return bless $self;
}

sub error { shift->{error} }
#> Возвращает текст ошибки, (он хранится в переменной $self->{error} внутри объекта. Ее туда помещают разные функции при выполнении.)
#>c Извне: $error = $cb->error; # где $cb - объект класса ClerverBot
#> Внутри функций этого модуля: 
#>c считывание: $self->error
#>c установка: $serf->{error} = "недостаточно параметров или что!", return 0;
#> Для вызывающих программ признаком необходимости прочитать текст ошибки является возврат false значения из вызываемой функции.
#> В Perl false значением является 0, "" и undef

sub debug_call { my $self = shift; print @_ if $self->{debug_call} }
#> Это функция печатает переданное ей сообщение с целью отладки если установлена $self->{ debug_call }
#> $cb->debug_call("Called sub 'explore'...");

sub debug_explain{ 
#> Печатает переданное ей сообщение с целью отладки если установлена $self->{ debug_explain }
#>c $cb->debug_explain( "Called sub 'explore'..." );
#> debug_explain используется для более многословной отладки чем debug_call, которая используется лишь для констатации вызова
 my $self = shift; 
 print @_ if $self->{debug_explain} 
}


sub set_conf{
#>c $ok = $cb->set_conf("/path/file.conf");
#> Вызывается изне перед началом работы для установки конкретного конфа для использования.

 my $self = shift;
 my $conf = shift;
 $self->{error} = "first parameter most be a file name! (".__FILE__." line ".__LINE__.")", return 0 if !$conf;
 $self->{error} = "File '$conf' not found (".__FILE__." line ".__LINE__.") ", return 0 if !-e $conf;
#> Конф обрабатывается по опледеленным правилам, и соответственно, должен иметь определенный синтаксис.
 open CONF, $conf or die "Can't open conf file '$conf': $!. ( use flag -c 'path/conf_name' for set conf )";
 my %conf;
 while ( <CONF> ){
    chomp;
    #> Решетка в начале строки означает комментарий.
    next if /^\s*\#/;
    #> Пробелы в начале и конце строк игнорируются.
    s/\s+$//; 
    s/^\s+//;
    #> Пустые строки игнорируются.
    next if !$_;
    #> Комментарии в стиле '# комментарий...' игнорируются.
    s/\s*\#.*?$//; # delete  comments at the end of line
    #> Все, что осталось, должно представлять на два поля, разделенных знаком "="(равно) вокруг которого допускаются пробелы.
    #> Эти два поля - ключ (имя переменной) и значение.
    my ($key, $val) = /^\s*(.+?)\s*\=\s*(.+)/;
#    die Dumper $key, $val if $key eq 'data_source';
    #> Ключи и значения заполняют хеш-массив %conf.
    $conf{ $key } = $val;
 }
 #> После успешной загрузки, ссылка на %conf хранится в $self->{conf}.
 #> То есть, для внешних программ, если $cb - это объект модуля CleverBot.pm
 #> ,то доступ к переменным конфа: $cb->{conf}
 #> Пример: получим имя lock-файла записанного в конфе как lock_file = path/filename.lock
 #>c $lock_name = $cb->{conf}{lock_file};
 $self->{conf} = \%conf;
 #> Имя самого конф-файла хранится в $self->{conf_name}.
 $self->{conf_name} = $conf; 
}

sub conf{
 #>c $some_conf_val = $cb->conf("some_key");
 #> Или:
 #>c $some_conf_val = $cb->conf("some_key","default_val"); 
 #> Возвращает значение по ключу из загруженного конфа ( см. set_conf() )
 #> Используется вместо непосредственного доступа к переменной  $cb->{conf}{"some_key"}.
 #> А так же в случаях, когда программист хочет иметь автоматически сформированное 
 #> сообщение об ошибке, записанное в $self->{error}, об отсутствии нужной переменной в конфе.
 my $self = shift;
 #> Параметры: 
 #>"some_key" - ключ, по кот. нужно получить значение из конфа,
 #> "default_val" - значение по умолчению, которое должна вернуть функция, если значения по ключу не окажется.
 my ($key, $default) = @_;
 my $rv;
 if ( !$self->{ conf }->{ $key } ){
    #> Если в конфе не оказывается такой переменной, то в $self->{error} записывается сообщение об этом.
    $self->{error} = "Value of $key in conf file '$self->{conf_name}' is empty. ";
    if ( $default ){
	#> Если передан параметр default_val, то сообщение в $self->{error} дополняется извещением об использовании данного значения,
	#> и происходит возврат default_val.
	$self->{error} .= " I will use default value = '$default' ";
	$rv = $default;
    }
    else{
	#> Если нужная переменная ('some_key' в нашем случае) не найдена в конфе и параметра default_val нет
	#> то возвращается 0.
	$rv = 0;
    }
    $self->{error} .= "Please edit '$self->{conf_name}' and set this value. (".__FILE__." line ".__LINE__.")" 
 }else{
    #> Если нужная переменная найдена, то возвращается ее значение.
    $rv = $self->{ conf }->{ $key };
 } 
 return $rv;
}

sub i_am_running{
 #>c $process_exist =  $cb->i_am_running( lock=>"file.lock", set_lock=>1 );
 #> Проверяет запущен ли процесс путем проверки файла, указанного в параметре lock и номера процесса, указанного в этом файле.
 #> Возвращает PID запущенного процесса, если процесс уже запущен и 0 если нет.
 #> При указании параметра set_lock=>1, при отсутствии процесса будет создан новый lock_file с указанием текущего процесса.
 #> При этом вернет 0.
 #> Если set_lock не указывать, новый lock-файл записываться не будет, а проводится лишь проверка процесса.
 my $self = shift;
 my %pa =@_;
 my $f = $pa{lock} or die "lock";
 my $set_lock = $pa{set_lock};
 if( -e $f ){
       open LOCK,"$f" or die $!;
       my $pid = <LOCK>;
       close LOCK;
       chomp($pid);
       if( -d "/proc/$pid" ){
	    #$self->{error} .= "/proc/$pid exists.";
	    return $pid;
       }else{
    	    #$self->{error} .= "/proc/$pid not exists.";
       }
 }
 if ( $set_lock ){
     my $old_mask = umask;
     umask 0111;
     open LOCK,">$f" or die "Can't oper for write $f: $!";
     print LOCK $$;
     close LOCK;
     umask $old_mask;
 } 
 return 0;
}

sub launch{
 #> Запускает сканирование сайтов. 
 #> Каждый модуль сканирует свой сайт. Если вы захотите написать свой сканирующий модуль, то требования к нему 
 #> вытекают из реализации mетода launch, описанного здесь. 
 my $self = shift;
 #> Папку для поиска модулей сканирования сайтов launch берет из переменной sites_dir конфига
 #> Написанный новый модуль должен быть помещен в эту папку, чтобы он был автоматически обнаружен и запущен при сканироваии.
 my $sites_dir = $self->{conf}{sites_dir}||'./sites';
 $sites_dir =~s/[\/\\\s]+$//;
 #> Сохраняет лог текущего запуска в файле, определенном переменной stat_log конфига, то есть если модуль не работает
 #> то ищем в конфе переменную stat_log, получаем имя файла лога, и в нем читаем ошибки.
 my $stat_log = $self->conf("stat_log") or $self->{error} = "stat_log variable is empty! in conf? (".__FILE__." line ".__LINE__.") ", return 0;

 #> Чтобы предотвратить запуск сканирования когда предыдущий запуск еще не отработал, используется lock_file (см. в конфе его имя).
 my $lock_file = $self->conf("lock_file") or $self->{error} = "lock_file variable is empty! in conf? (".__FILE__." line ".__LINE__.") ", return 0;
 #> Метод launch() проверяет этот файл, считывает там номер PID, проверяет существование такого процесса, и если он существует, 
 #> то делает досрочный выход.
 if ( my $pid = $self->i_am_running( lock=>"$lock_file", set_lock => 1 ) ){
     $self->{error} .= "I am already running! PID=$pid. '. (".__FILE__." line ".__LINE__.")", return 0;
 }
 #> Если в конфе не определено значение sites_dir, то launch запишет ошибку "sites_dir is empty!"
 $self->{error} = "sites_dir is empty! (".__FILE__." line ".__LINE__.")", return 0 if ! $sites_dir;
 #> Если она определена, но ее нету, то ошибка: "Directory '$sites_dir' not found"
 $self->{error} = "Directory '$sites_dir' not found (".__FILE__." line ".__LINE__.") ",return 0 if ! -d $sites_dir;
 #> Открывает эту папку, и если не смог этого сделать - ошибка "Can't open $sites_dir"
 opendir SITES, "$sites_dir" or  $self->{error} = "Can't open $sites_dir: $! (".__FILE__." line ".__LINE__.")", return 0;
 #> Очищает статистику запуска, для заполнения ее свежими данными, удаляя из таблицы stat все записи со словом launching\_package
 $self->do_sql(sql=>"DELETE FROM stat WHERE name_en LIKE 'launching\_package\_%' "); # delete statistic

 #> Подключает все найденные модули и в каждом вызывает метод explore().
 #> (что означает, что разработчик во вновь созданном сканирующем модуле должен определить метод explore() )
 NAME: while ( my $name = readdir SITES ){
    next if $name =~/^\./;
    #> launch() будет читать модулем только файлы с расширением pm, остальные - игнорирутся.
    next if $name !~/\.pm$/;
    my $thf = __FILE__;
    #> (а также CleverBot.pm игнорирует сам себя на всякий случай)
    next if $name =~/$thf/;
    my $full_name = "$sites_dir/$name";
    #> Именем подключаемого пакета он считает имя файла без расширения pm.
    my ($pkg) = $name=~/(.+?)\.pm/;
        
    $@ = '';
    my $mod;
    my $explore_rv;
    
    #> Каждый модуль хочет что-то записать на диск в ствою отдельную папочку.
    #> Поэтому для каждого модуля до его запуска создается папка с именем $sites_dir/$pkg\_data.
    my $data_dir = "$sites_dir/$pkg\_data";
    if ( !-d $data_dir ){
	    my $oum = umask;
	    #> Папки создаются с маской, обеспечивающей доступ к созданным папкам для пользователя, под которым работает веб-сервер. 
	    umask 0022;
	    mkdir $data_dir or $self->{error} .= "Can't create dir '$data_dir' (".__FILE__." line ".__LINE__."):\n $! ", next NAME;
	    umask $oum;
    }   
    
    my $oum = umask;
    umask 0111;
    eval { 
	#><BR> Поскольку эти подключаемые модули сложны и индивидуальны для каждого сайта, метод explore каждого из них вызывается в блоке eval.
	#> Eval позволяет продолжить программу после фатальной ошибки.    
	require $full_name;
	$mod = $pkg->new();
	#die Dumper $pkg, $mod;
	
	#> Модуль, когда ему захочется получить имя папки, в которой он может создавать файлы, возьмет это имя в переменной $c->{data_dir} 
	$self->{data_dir} = $data_dir;
	#> Заранее приготовим имя файла, в который модуль запишет найденные на сайте ссылки, он возмет его в $s->{list_file}.
	$self->{list_file} = "$data_dir/$pkg.list";
	#> $c - объект модуля CleverBot.pm, которое передается методу explore вторым параметром после имени самого вызываемого модуля.
	#> В этом объекте находятся все доступные модулю переменные и методы модуля CleverBot.pm. 
	#> Посмотрите код реализованных сканирующих модулей, чтобы увидеть, какие переменные и методы можно использовать
	#>( это будут все обращения к переменный $c в виде $c->метод() или $c->{переменная} ).
	#> Наконец, вызовем метод explore сканирующего модуля. Результат, который он вернет сохраним в переменной, чтобы знать как он отработал.
	$explore_rv = $mod->explore( $self );
    };
    umask $oum;
    my %stat;
    @stat{qw/ name_en name_ru datetime /} = ("launching_package_$pkg","Запуск модуля сканирования $pkg", undef );

    if ( !$explore_rv ){
	#><BR> Если какой-то из модулей вернул нулевое значение, то это считается ошибкой. Это способ модуля сообщить о том, что 
	#> что-то не в порядке и поэтому он не хочет работать.
	#> Ошибка считывается из модуля (из его переменной $mod->{error}) и записывается в таблицу stat напротив строк:
	#> "launching_package_$pkg","Запуск модуля сканирования $pkg",
	#> в колонку datetime будет помещено текущее значение даты-времени
	#> в колонку val записывается 0
	#> в колонку comment таблицы записывается тект ошибки.
	#> Следовательно, разработчик модуля сканирования должен объявить там переменную модуля $error.
	my $err = $mod->{error}||$@||'';
	$self->{error} .= "Error in module '$full_name' (".__FILE__." line ".__LINE__."):\n $err";
	@stat{qw/ val comment /} = ( 0, $err );
	$self->set_stat( %stat ) or $self->{error} .= "Can't call set_stat' (".__FILE__." line ".__LINE__.")";
	#> Выполнение переходит к другому модулю.
	next NAME;
    }
    if ( $@ ){
	#><BR> Аналогично - при обнаружении ошибки в переменной $@. $@ - встроенная переменная Perl, которая хранит ошибку
	#> в случае неудачного вызова eval. Она заполнится в случае, если модуль не только не вернет ненулевого значения
	#> но и вовсе загнется, например от синтаксической ошибки или фатальной ошибки выполнения.
	$self->{error} .= "Error while call method explore() (".__FILE__." line ".__LINE__.")\n in '$full_name' : $@ ";
	@stat{qw/ val comment /} = ( 0, $@ );
	$self->set_stat( %stat ) or $self->{error} .= "Can't call set_stat' (".__FILE__." line ".__LINE__.") ";
	#> Выполнение переходит к другому модулю.
	next NAME;
    }
    #> Предусмотрена ситуация, когда разработчик или администратор хочет отключить модуль сканирования.
    #> Тогда переменная модуля $enabled устанавливается в 0
    #> После запуска метода explore() модуля он сам проверяет значение этой переменной и выходит если оно равно нулю
    #> return 1 if !$enabled
    #> При этом он возвращает 1, что означает- "ошибки модуля не было"
    #> launch() получив 1 после вызова explore() проверяет был ли это удачный вызов сканирования сайта или модуль "дал пас" и ничего не делал
    #> для этого launch вызывает метод enabled() модуля сканирования, (который возвращает значение переменой $enable) и если
    #> он вернул 0 то ему понятно, что модуль не сканировал сайт, а решил откосить, хотя ошибок выполнения в нем не было.
    #> Следовательно разработчик модуля сканирования должен определить в модуле метод enabled() возвращающий значение $enabled
     
    my $val = $mod->enabled||0;            
    #> Итак, если Сканирующий модуль отработал без ошибок (вернул 1), то если enabled() возвращает 0, то в статистику вызова
    #> Записывается "Disabled" (в комментарий). А если enabled() вернул 1 - то "Ok"
    my $comment = $val ? "Ok" : "Disabled";
    @stat{qw/ val comment /} = ( $val, $comment);
    $self->set_stat( %stat ) or $self->{error} .= "Can't call set_stat' (".__FILE__." line ".__LINE__.")";
 }
 closedir SITES;

 #> <BR>Открывается статистический файл stat_log и в него записывается копия сообщений из БД-таблицы stat
 #> Это сделано, чтобы можно было посмотреть статистику вызова в файле (не залезая в БД).
 open STAT, ">$stat_log" or $self->{error} .= "Can't open $stat_log' (".__FILE__." line ".__LINE__."):\n $! ";
 my $sth = $self->find(table=>"stat",where=>"");
 while ( my @r = $sth->fetchrow_array() ){
    print STAT join( "\t", @r ) , "\n";
 }
 close STAT;
 
}

sub db{ 
 #>c $dbh = $cb->db
 my $self = shift;
 $self->debug_call( "call db\n" );
 if ( !$self->{db} or !ref $self->{db} ){
    #> Смотрит на переменную конфа db_engine и использует ее в качестве имени модуля, который предоставит объект работы с БД.
    my $mod_name = $self->{conf}->{db_engine}||"DB_sqlite.pm";
    $@ = '';
    eval {
	$self->debug_call( "call require\n" );
	#> Подключает этот модуль.
	require $mod_name;
	my ($pkg) = $mod_name =~/^(.+?)\.pm/;
	#> Создает и возвращает новый объект этого модуля.
	#> Ссылка на объект сохраняется в $self->{db} и используется при следующих вызовах без создания нового объекта.
	$self->{db} = $pkg->new( $self );
    };
    $self->{error} .= "(".__FILE__." line ".__LINE__."):\n $@", return 0 if $@;
 }
 #> Предполагается, что объект работы с БД имеет следующие методы:
 #> set_news, do_sql, find, error (не считая конструктора new).
 return $self->{db};

}

sub set_news{ 
 #> Передает объекту работы с БД вызов метода set_news со всеми параметрами.
 #> Таким образом, что вместо 
 #>c $cb->db()->set_news(...)
 #> Можно писать: 
 #>c $cb->set_news(...)
 #> Что, впрочем, не обязательно использовать.
 #> Прим.: Функция set_news используется модулями сканирования для занесения конкурса в БД.
 #> Подробное описание см. в модуле работы с БД.
 my $self = shift; 
 my $rv = $self->db()->set_news( @_ );
 $self->{error} = $self->db()->error if !$rv;
 return $rv;
}

sub do_sql{ 
 #> Передает объекту работы с БД вызов метода do_sql со всеми параметрами.
 #> Таким образом, что вместо 
 #>c $cb->db()->do_sql(...)
 #> Можно писать: 
 #>c $cb->do_sql(...)
 my $self = shift; 
 my $rv = $self->db()->do_sql( @_ );
 $self->{error} = $self->db()->error if !$rv;
 return $rv;
}

sub find{
 #> Передает объекту работы с БД вызов метода find со всеми параметрами.
 #> Таким образом, что вместо 
 #>c $cb->db()->find(...)
 #> Можно писать: 
 #>c $cb->find(...)
 my $self = shift;
 my $rv = $self->db()->find( @_ );
 $self->{error} = $self->db()->error if !$rv;
 return $rv;
}

sub mon_incr{
 my $self = shift;
 #> Операции инкремента/декремента месяцев.
 #> usage: 
 #>c ($m,$y) = $cb->mon_incr("01","2009",-1); # return (12,2008)
 # На входе: месяц, год, инкремент
 # На выходе: получившиеся значения месяц и год
 my ( $m, $y , $incr) = @_;
 $m or die "m!";
 $y or die "y!";
 $incr+=0;
 if ( $incr > 0 ){
    $m += $incr;
    $m-=12, $y+=1 while $m>12;
 }
 else{
    $m += $incr;
    $m+=12, $y-=1 while $m<1; 
 }
 return ($m,$y);
   
}

sub my_date{
 #> В БД время/дата хранится в строках вида YYYYMMDDhhmmss.
 #> Для формирования строк такого вида и, наоборот, удобного выделения из них величин даты используется эта функция.
 #> Usage: 
 #>i Current date in format YYYYMMDDhhmmss:
 #>c $d = $self->my_date(); # $d = '20091131235901' 
 #>or 
 #>i Current date as list: (YYYY,MM,DD,hh,mm,ss):
 #>c @d = $s->my_date(); # @d = (2009,11,31,23,59,01)
 #>or
 #>i (YYYY,MM,DD,hh,mm,ss) from YYYYMMDDhhmmss:
 #>c @d = $s->my_date($d); # @d = (2009,11,31,23,59,01)
 
 my $self = shift;
 die " First parameter most be a reference to self-object! (".__FILE__." line:".__LINE__."). " if ! ref $self;
 my @dt;
 if ( @_ == 1 ){
    my $in_dt = shift; 
    $in_dt =~ s/\D//g;
    die "parameter \$in_dt=$in_dt - most be a YYYYMMDDhhmmss digit!" if ! $in_dt =~ m/(\d{14})/;
    @dt = $in_dt =~/(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/ or die "can't parse $in_dt!";
 }
 elsif( @_ > 1 ){
    my ( $y,$m,$d,$h,$mi,$s) = @_;
    
     $y =~/\d{4}/ or die "year! ($y)";
     my %h = (y=>$y, m=>$m, d=>$d, h=>$h, mi=>$mi, s=>$s);
     for my $k ( keys %h ){
        $h{$k}+=0;
        $h{$k} >= 0 or die "$k! ($h{$k})";
	 
     }
    
     $m = sprintf("%02d",$m);
     $d = sprintf("%02d",$d);
     $h = sprintf("%02d",$h);
     $mi = sprintf("%02d",$mi);
     $s = sprintf("%02d",$s);
     
     @dt = ($y,$m,$d,$h,$mi,$s);
 }
 else{
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
     $year+=1900;
     $mon+=1;
     $mon = sprintf("%02d",$mon);
     $mday = sprintf("%02d",$mday);
     $hour = sprintf("%02d",$hour);
     $min = sprintf("%02d",$min);
     $sec = sprintf("%02d",$sec);
     @dt = ($year,$mon,$mday,$hour,$min,$sec);
 }
 if ( wantarray ){
    return @dt;
 }else{
    return join '', @dt;
 }
}

sub set_stat{
 #> Set statistic information about any process
 #>c usage: $self->set_stat( name_en=>"my_var1", name_ru=>"перем 1", val=>"five", comment=>"All -ok" );
 #> В БД существует специальная таблица stat, в кот. записывается всякая информация, которую разработчик решит туда записать.
 #> Эта информация впоследствии отображается в странице "Сервис"->"Статистика" и в файле stat.log

 my $self = shift;
 my $tbl = "stat";
 my %pars = @_;
 #> Таблица имеет поля, имена которых совпадают с именами параметров при вызове этой функции:

 #>c name_en TEXT NOT NULL PRIMARY KEY, - имя параметра на английском, желательно одним словом без пробелов, чтобы можно было потом по нему искать, 
 $pars{name_en} or $self->{error} = "param name_en! (".__FILE__." line:".__LINE__."). ", return 0;

 #>c name_ru TEXT NOT NULL, - имя параметра по русски в качестве отображаемого имени, 
 $pars{name_ru}||="";

 #>c val TEXT NOT NULL, - значение параметра, 
 defined $pars{val} or $self->{error} = "param val not defined! (".__FILE__." line:".__LINE__.").", return 0;

 #>c comment TEXT NOT NULL, - комментарий к значению, 
 $pars{comment}||="";

 #>c datetime INTEGER NOT NULL  - дата/время (заполняется автоматичесики).
 $pars{datetime}||=$self->my_date();
 
 #> Из таблицы удаляется строка, где значение поля name_en совпадает со значением переданного параметра name_en.
 $self->do_sql( sql => "DELETE FROM $tbl WHERE name_en = ?", bind_values => [ $pars{name_en} ] );
 #> После этого в таблицу вставляется новая строка с полями, соответственно заполненными полями.
 my $aff = $self->do_sql( sql => "INSERT INTO $tbl (name_en, name_ru, val, comment, datetime) VALUES (?,?,?,?,?)",
    bind_values => [@pars{qw/ name_en name_ru val comment datetime /}] );
 $aff or $self->{error} = "Error while set_stat. (".__FILE__." line:".__LINE__."). ".$self->error , return 0;
 return $aff;
}



#end of package:
1;


